Este modelo abarca el período de tiempo desde 2019 hasta julio de 2024, con una frecuencia semanal.
Se bajan los datos
ruta_productos <- "/cloud/project/df_dif.xlsx"
excel_sheets(ruta_productos)
## [1] "Sheet 1"
productos <- as.data.frame(read_xlsx(ruta_productos, sheet = "Sheet 1",
col_names = T))
productos <- select(.data = productos, c("Fecha", "dif"))
colnames(productos) <- c("Fecha", "Totales")
productos$Semana <- format(x = productos$Fecha, format = c("%Y-%U"))
nrow(productos)
## [1] 694
head(productos)
## Fecha Totales Semana
## 1 2019-07-03 -2.8586186 2019-26
## 2 2019-07-04 0.6996184 2019-26
## 3 2019-07-05 0.8669633 2019-26
## 4 2019-07-06 0.1055037 2019-26
## 5 2019-07-08 0.5360249 2019-27
## 6 2019-07-09 -1.4721819 2019-27
productos <- productos %>%
group_by(Fecha = as.character(Semana)) %>%
summarize(Totales = sum(Totales),
.groups = "keep")
head(productos)
## # A tibble: 6 × 2
## # Groups: Fecha [6]
## Fecha Totales
## <chr> <dbl>
## 1 2019-26 -1.19
## 2 2019-27 -1.92
## 3 2019-28 1.17
## 4 2019-29 -0.484
## 5 2019-30 -0.675
## 6 2019-31 1.60
productos_sem_ts <- ts(data = productos$Totales,start = 1,frequency = 1)
productos_sem_xts <- as.xts(productos_sem_ts, dateFormat = "POSIXct")
urca::ur.df(productos_sem_ts)
##
## ###############################################################
## # Augmented Dickey-Fuller Test Unit Root / Cointegration Test #
## ###############################################################
##
## The value of the test statistic is: -20.7143
El valor del estadístico de Dickey-Fuller es -20.7143 Este resultado, significativamente menor que el valor crítico, nos permite rechazar la hipótesis nula de que la serie tiene una raíz unitaria a un nivel de significancia del 5%. En consecuencia, se concluye que la serie de tiempo es estacionaria.
kpss.test(productos_sem_ts)
## Warning in kpss.test(productos_sem_ts): p-value greater than printed p-value
##
## KPSS Test for Level Stationarity
##
## data: productos_sem_ts
## KPSS Level = 0.014359, Truncation lag parameter = 4, p-value = 0.1
KPSS Level = 0.014359, Truncation lag parameter = 4, p-value = 0.1 Ho:La serie de tiempo es estacionaria. Ha:La serie de tiempo no es estacionaria. Dado que el valor p es 0.1, mayor al nivel de significancia de 0.05, no se rechaza la hipótesis nula.
ggAcf(productos_sem_ts, col = "red", lag.max = 52)
ggPacf(productos_sem_ts, col = "blue", lag.max = 52)
dividida_sem_ts <- ts_split(productos_sem_ts,
sample.out = round(length(productos_sem_ts)*0.2))
entrena_productos_sem_ts <- dividida_sem_ts$train
prueba_productos_sem_ts <- dividida_sem_ts$test
modelo_prod_sem <- auto.arima(entrena_productos_sem_ts, stationary = T, stepwise = F)
summary(modelo_prod_sem )
## Series: entrena_productos_sem_ts
## ARIMA(5,0,0) with zero mean
##
## Coefficients:
## ar1 ar2 ar3 ar4 ar5
## -0.8420 -0.6320 -0.4051 -0.4041 -0.2779
## s.e. 0.0693 0.0877 0.0943 0.0875 0.0693
##
## sigma^2 = 2.384: log likelihood = -357.63
## AIC=727.26 AICc=727.71 BIC=746.87
##
## Training set error measures:
## ME RMSE MAE MPE MAPE MASE ACF1
## Training set -0.02939907 1.523993 1.238329 Inf Inf 0.4019376 -0.0116012
# AIC=727.26 AICc=727.71 BIC=746.87
# ARIMA(5,0,0) with zero mean
checkresiduals(modelo_prod_sem, col = "red") # p-value = 0.4654
##
## Ljung-Box test
##
## data: Residuals from ARIMA(5,0,0) with zero mean
## Q* = 4.6091, df = 5, p-value = 0.4654
##
## Model df: 5. Total lags used: 10
pronostico_sem_prod <- forecast(modelo_prod_sem ,
h = length(prueba_productos_sem_ts),
level = 0.95)
accuracy(prueba_productos_sem_ts, pronostico_sem_prod$mean)
## ME RMSE MAE MPE MAPE ACF1 Theil's U
## Test set 0.004717644 2.518968 1.940655 527284.5 1593630 -0.3556576 239.8227
# ME RMSE MAE MPE MAPE
#Test set 0.004717644 2.518968 1.940655 527284.5 1593630
accuracy(prueba_productos_sem_ts[1:10], pronostico_sem_prod$mean[1:10])
## ME RMSE MAE MPE MAPE
## Test set -0.2624565 2.624804 2.082836 -399950 401503
# ME RMSE MAE MPE MAPE
# Test set -0.2624565 2.624804 2.082836 -399950 401503